intervention.lm <- intervention_mobility_case %>%
mutate(EmergDec.duration = cumsum(EmergDec))
lm.fit.no.lag <- lm(full_time_work_prop ~ EmergDec.duration + smoothed_cli+smoothed_adj_cli, data =intervention.lm
)
intervention.lm$predlm <- c(rep(NA, nrow(intervention.lm) - length(predict(lm.fit.no.lag))), predict(lm.fit.no.lag))
intervention.lm%>%
mutate(policy.duration = cumsum(EmergDec), EmergDeclaration = as.factor(EmergDec)) %>%
ggplot(aes(x = time_value, y = full_time_work_prop, color = EmergDeclaration)) +
geom_point() +
geom_line(aes(x = time_value, y = predlm, colour="fitted value"), size = 1)+
labs(title = "Covariates selected WITHOUT most correlated number of shift")
We suspect that the mobility signal is lower than usual during the weekend.
intervention_mobility_case$weekday <- weekdays(as.Date(intervention_mobility_case$time_value))
p <- ggplot(intervention_mobility_case, aes(x=weekday, y=full_time_work_prop)) +
geom_boxplot()
p
##
## Call:
## lm(formula = full_time_work_prop ~ EmergDec.duration + smoothed_cli +
## smoothed_adj_cli)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0208421 -0.0026275 -0.0001302 0.0029902 0.0131662
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.976e-02 1.022e-03 38.918 < 2e-16 ***
## EmergDec.duration 5.185e-05 1.244e-05 4.169 5.16e-05 ***
## smoothed_cli 7.097e-04 7.307e-04 0.971 0.333
## smoothed_adj_cli -2.629e-04 8.398e-04 -0.313 0.755
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.004876 on 150 degrees of freedom
## (328 observations deleted due to missingness)
## Multiple R-squared: 0.4393, Adjusted R-squared: 0.4281
## F-statistic: 39.18 on 3 and 150 DF, p-value: < 2.2e-16
##
## Call:
## lm(formula = full_time_work_prop ~ policy.duration + smoothed_cli +
## smoothed_adj_cli)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0305809 -0.0058044 -0.0005214 0.0055933 0.0242504
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.576e-02 1.248e-03 44.671 < 2e-16 ***
## policy.duration 5.029e-05 1.346e-05 3.736 0.000245 ***
## smoothed_cli 1.837e-03 9.248e-04 1.986 0.048441 *
## smoothed_adj_cli -4.955e-03 1.208e-03 -4.104 5.99e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.008831 on 194 degrees of freedom
## (284 observations deleted due to missingness)
## Multiple R-squared: 0.1633, Adjusted R-squared: 0.1504
## F-statistic: 12.62 on 3 and 194 DF, p-value: 1.427e-07
##
## Call:
## lm(formula = full_time_work_prop ~ EmergDec.duration + smoothed_cli +
## smoothed_adj_cli + confirmed_7dav_incidence_num + confirmed_7dav_cumulative +
## confirmed_7dav_cumulative_prop + deaths_7dav_incidence_num +
## deaths_7dav_cumulative_num)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0197354 -0.0031287 -0.0000458 0.0030361 0.0123833
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.811e-02 4.510e-03 10.667 < 2e-16 ***
## EmergDec.duration -9.391e-05 7.241e-05 -1.297 0.19682
## smoothed_cli 7.370e-04 7.269e-04 1.014 0.31239
## smoothed_adj_cli -1.310e-03 9.767e-04 -1.342 0.18189
## confirmed_7dav_incidence_num 1.026e-06 3.302e-07 3.106 0.00230 **
## confirmed_7dav_cumulative -1.019e-08 1.179e-08 -0.864 0.38886
## confirmed_7dav_cumulative_prop NA NA NA NA
## deaths_7dav_incidence_num 1.037e-04 3.222e-05 3.218 0.00161 **
## deaths_7dav_cumulative_num 1.677e-06 1.294e-06 1.296 0.19700
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.004806 on 138 degrees of freedom
## (336 observations deleted due to missingness)
## Multiple R-squared: 0.4433, Adjusted R-squared: 0.4151
## F-statistic: 15.7 on 7 and 138 DF, p-value: 4.839e-15
# Try to add other intervention covariates
factored_data.without.weekend %$%
lm(full_time_work_prop ~EmergDec.duration +StayAtHomeDuration+PublicMaskDuration+SchoolCloseDuration+GathRestrictDuration+BarRestrictDuration+NEBusinessCloseDuration+ RestaurantRestrictDuration+ smoothed_cli+smoothed_adj_cli+confirmed_7dav_incidence_num+confirmed_7dav_cumulative+confirmed_7dav_cumulative_prop+deaths_7dav_incidence_num+deaths_7dav_cumulative_num+ SchoolCloseDuration) %>%
summary()
##
## Call:
## lm(formula = full_time_work_prop ~ EmergDec.duration + StayAtHomeDuration +
## PublicMaskDuration + SchoolCloseDuration + GathRestrictDuration +
## BarRestrictDuration + NEBusinessCloseDuration + RestaurantRestrictDuration +
## smoothed_cli + smoothed_adj_cli + confirmed_7dav_incidence_num +
## confirmed_7dav_cumulative + confirmed_7dav_cumulative_prop +
## deaths_7dav_incidence_num + deaths_7dav_cumulative_num +
## SchoolCloseDuration)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.0197354 -0.0031287 -0.0000458 0.0030361 0.0123833
##
## Coefficients: (8 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.811e-02 4.510e-03 10.667 < 2e-16 ***
## EmergDec.duration -9.391e-05 7.241e-05 -1.297 0.19682
## StayAtHomeDuration NA NA NA NA
## PublicMaskDuration NA NA NA NA
## SchoolCloseDuration NA NA NA NA
## GathRestrictDuration NA NA NA NA
## BarRestrictDuration NA NA NA NA
## NEBusinessCloseDuration NA NA NA NA
## RestaurantRestrictDuration NA NA NA NA
## smoothed_cli 7.370e-04 7.269e-04 1.014 0.31239
## smoothed_adj_cli -1.310e-03 9.767e-04 -1.342 0.18189
## confirmed_7dav_incidence_num 1.026e-06 3.302e-07 3.106 0.00230 **
## confirmed_7dav_cumulative -1.019e-08 1.179e-08 -0.864 0.38886
## confirmed_7dav_cumulative_prop NA NA NA NA
## deaths_7dav_incidence_num 1.037e-04 3.222e-05 3.218 0.00161 **
## deaths_7dav_cumulative_num 1.677e-06 1.294e-06 1.296 0.19700
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.004806 on 138 degrees of freedom
## (336 observations deleted due to missingness)
## Multiple R-squared: 0.4433, Adjusted R-squared: 0.4151
## F-statistic: 15.7 on 7 and 138 DF, p-value: 4.839e-15
# Predict the mobility
new.pred <- factored_data.without.weekend %$%
lm(full_time_work_prop ~EmergDec.duration +StayAtHomeDuration+PublicMaskDuration+SchoolCloseDuration+GathRestrictDuration+BarRestrictDuration+NEBusinessCloseDuration+ RestaurantRestrictDuration+ smoothed_cli+smoothed_adj_cli+confirmed_7dav_incidence_num+confirmed_7dav_cumulative+confirmed_7dav_cumulative_prop+deaths_7dav_incidence_num+deaths_7dav_cumulative_num+ SchoolCloseDuration)%>%
predict()
# Pad the fitted values with NA
factored_data.without.weekend$predlm <- c(rep(NA, nrow(factored_data.without.weekend) - length(new.pred)), new.pred)
# Plot the graph
factored_data.without.weekend %>%
ggplot(aes(x = time_value, y = full_time_work_prop, color = EmergDeclaration)) +
geom_point() +
geom_line(aes(y = predlm, colour="fitted value"), size = 1) +
labs(title = "All covariates selected WITH most correlated number of shift (weekends dropped)")